Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/version/ver10/sa_setup.frm

Text File | 1994-04-30 | 14KB | 552 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Setup Apprentice"
   ClientHeight    =   5490
   ClientLeft      =   1035
   ClientTop       =   2070
   ClientWidth     =   6390
   Height          =   6180
   Icon            =   SA_SETUP.FRX:0000
   Left            =   975
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5490
   ScaleWidth      =   6390
   Top             =   1440
   Width           =   6510
   Begin CommonDialog CMDialog1
      Left            =   5640
      Top             =   5040
   End
   Begin TextBox AppName
      Height          =   285
      Left            =   2280
      TabIndex        =   3
      Top             =   480
      Width           =   3855
   End
   Begin PictureBox Drop
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   4080
      Picture         =   SA_SETUP.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   8
      Top             =   5040
      Visible         =   0   'False
      Width           =   495
   End
   Begin PictureBox NoDrop
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   3480
      Picture         =   SA_SETUP.FRX:0604
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   7
      Top             =   5040
      Visible         =   0   'False
      Width           =   495
   End
   Begin Timer Timer1
      Interval        =   100
      Left            =   5160
      Top             =   5040
   End
   Begin DirListBox Dir1
      Height          =   1380
      Left            =   240
      TabIndex        =   1
      Top             =   1200
      Width           =   1815
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   1815
   End
   Begin FileListBox File1
      DragIcon        =   SA_SETUP.FRX:0906
      Height          =   2175
      Left            =   240
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      Top             =   3000
      Width           =   1815
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:0C08
      Height          =   1005
      Index           =   2
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   6
      Top             =   4080
      Width           =   3855
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:0F0A
      Height          =   1005
      Index           =   1
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   2760
      Width           =   3855
   End
   Begin ListBox IList
      DragIcon        =   SA_SETUP.FRX:120C
      Height          =   1395
      Index           =   0
      Left            =   2280
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   4
      Top             =   1080
      Width           =   3855
   End
   Begin Label Label7
      Caption         =   "Application Name:"
      Height          =   255
      Left            =   2280
      TabIndex        =   15
      Top             =   240
      Width           =   2295
   End
   Begin Label Label6
      Caption         =   "Files:"
      Height          =   255
      Left            =   240
      TabIndex        =   14
      Top             =   2760
      Width           =   1215
   End
   Begin Label Label5
      Caption         =   "Directory:"
      Height          =   255
      Left            =   240
      TabIndex        =   13
      Top             =   960
      Width           =   1215
   End
   Begin Label Label4
      Caption         =   "Drive:"
      Height          =   255
      Left            =   240
      TabIndex        =   12
      Top             =   240
      Width           =   1215
   End
   Begin Label Label3
      Caption         =   "System Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   11
      Top             =   3840
      Width           =   2295
   End
   Begin Label Label2
      Caption         =   "Windows Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   10
      Top             =   2520
      Width           =   2295
   End
   Begin Label Label1
      Caption         =   "Application Directory:"
      Height          =   255
      Left            =   2280
      TabIndex        =   9
      Top             =   840
      Width           =   2295
   End
   Begin Menu MenuFile
      Caption         =   "&File"
      Begin Menu MenuFileOpen
         Caption         =   "&Open"
      End
      Begin Menu MenuFileClose
         Caption         =   "&Close"
      End
      Begin Menu MenuFileSave
         Caption         =   "&Save"
      End
      Begin Menu MenuFileSaveAs
         Caption         =   "Save &As"
      End
      Begin Menu sep1
         Caption         =   "-"
      End
      Begin Menu MenuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu MenuCreateDisk
      Caption         =   "Create Disk!"
      Enabled         =   0   'False
   End
   Begin Menu MenuHelp
      Caption         =   "&Help"
      Begin Menu MenuHelpAbout
         Caption         =   "&About Setup Apprentice ..."
      End
   End
End
Option Explicit

Dim SetupFilename As String

Dim fChanged As Integer
Dim StartDrag As Integer
Dim DragStart As Integer
Dim DragCount As Integer

Sub AppName_Change ()
    SetFormCaption

    MenuCreateDisk.Enabled = Len(AppName.Text)
End Sub

Function CheckSave () As Integer
    If fChanged Then
    End If

    CheckSave = True
End Function

Sub Dir1_Change ()
    File1.Path = Dir1.Path
End Sub

Sub Dir1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Drive1_Change ()
    Dir1.Path = Drive1.Drive
End Sub

Sub Drive1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub File1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = 1) And File1.ListIndex <> -1 Then
        StartDrag = True
        DragStart = -1
        Timer1.Enabled = True
    End If
End Sub

Sub File1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button = 1) Then StartDrag = False: File1.Drag 0
End Sub

Sub Form_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Form_Load ()
    SetupClear
    SetFormCaption
End Sub

Sub Form_Unload (Cancel As Integer)
    If CheckSave() Then End
End Sub

Sub IList_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
    Dim fAdd As Integer
    Dim I As Integer
    Dim J As Integer
    Dim N As Integer
    Dim S As String
    Dim DirPath As String

    fChanged = True

    If (DragStart <> Index) Then
        If (DragStart = -1) Then
            N = File1.ListCount

            If Right$(Dir1.Path, 1) = "\" Then
                DirPath = Dir1.Path
            Else
                DirPath = Dir1.Path & "\"
            End If
        Else
            N = IList(DragStart).ListCount
        End If

        For I = N - 1 To 0 Step -1
            S = ""

            If (DragStart = -1) Then
                If File1.Selected(I) Then S = DirPath & File1.List(I)
            ElseIf IList(DragStart).Selected(I) Then
                S = IList(DragStart).List(I)
                IList(DragStart).RemoveItem I
            End If

            If Len(S) Then
                fAdd = True

                For J = 0 To IList(Index).ListCount - 1
                    If S = IList(Index).List(J) Then
                        fAdd = False
                        Exit For
                    End If
                Next J

                If fAdd Then IList(Index).AddItem S
            End If
        Next I
    End If
End Sub

Sub IList_MouseDown (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim I As Integer


    If (Button = 1) And IList(Index).ListIndex <> -1 Then
        StartDrag = True
        DragStart = Index
        Timer1.Enabled = True
    End If

    If (Button = 2) Then
        MsgBox Format$(Y)
    End If
End Sub

Sub IList_MouseUp (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then StartDrag = False: IList(Index).Drag 0
End Sub

Sub Label1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Label2_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Label3_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Label4_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Label5_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub Label6_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    DragOver Source, State
End Sub

Sub MenuCreateDisk_Click ()
    Form1.Hide
    Form3.Show 1
    Form1.Show
End Sub

Sub MenuFileClose_Click ()
    If CheckSave() Then SetupClear
End Sub

Sub MenuFileExit_Click ()
    If CheckSave() Then End
End Sub

Sub MenuFileOpen_Click ()
    On Error GoTo NoOpen
    CMDialog1.Filename = "*.SA"
    CMDialog1.Flags = &H9804
    CMDialog1.Filter = "Setup Assitant (*.SA)|*.SA|All Files (*.*)|*.*"
    CMDialog1.CancelError = True
    CMDialog1.Action = 1

    OpenSetup CMDialog1.Filename

    SetupFilename = CMDialog1.Filename
    Call SetFormCaption

    GoTo OpenDone

NoOpen:
    Resume OpenDone

OpenDone:
    On Error GoTo 0
End Sub

Sub MenuFileSave_Click ()
    If AppName.Text = "" Then
        Beep
        MsgBox "You need to fill in the Application Name.", 48, "Save File"
    ElseIf SetupFilename = "" Then
        Call MenuFileSaveAs_Click
    Else
        SaveSetup SetupFilename
    End If
End Sub

Sub MenuFileSaveAs_Click ()
    Dim I As Integer
    Dim S As String
    Dim C As String

    If AppName.Text = "" Then
        Beep
        MsgBox "You need to fill in the Application Name.", 48, "Save File"
        Exit Sub
    End If

    On Error GoTo NoSave

    If SetupFilename <> "" Then
        CMDialog1.Filename = "*.SA"
    Else
        S = ""

        For I = 1 To Len(AppName.Text)
            C = Mid$(UCase$(AppName.Text), I, 1)
            If ((C >= "A") And (C <= "Z")) Then S = S & Mid$(AppName.Text, I, 1)
        Next I

        CMDialog1.Filename = Left$(S, 8) & ".SA"
    End If

    CMDialog1.Flags = &H9804
    CMDialog1.Filter = "Setup Assitant (*.SA)|*.SA|All Files (*.*)|*.*"
    CMDialog1.CancelError = True
    CMDialog1.Action = 2

    SetupFilename = CMDialog1.Filename
    Call SetFormCaption

    SaveSetup CMDialog1.Filename
    GoTo SaveDone

NoSave:
    Resume SaveDone

SaveDone:
    On Error GoTo 0
End Sub

Sub MenuHelpAbout_Click ()
    Form2.Show 1
End Sub

Sub OpenSetup (ByVal Filename As String)
    Dim S As String

    SetupClear

    SetupFilename = Filename
    MenuCreateDisk.Enabled = False

    Open Filename For Input Access Read As #1

    While Not EOF(1)
        Input #1, S

        If Left$(S, 8) = "AppName" Then
            AppName.Text = Mid$(S, 9)
            MenuCreateDisk.Enabled = Len(AppName.Text)
        ElseIf Left$(S, 7) = "WinDir " Then
            IList(1).AddItem Mid$(S, 8)
        ElseIf Left$(S, 7) = "SysDir " Then
            IList(2).AddItem Mid$(S, 8)
        ElseIf Left$(S, 7) = "AppDir " Then
            IList(0).AddItem Mid$(S, 8)
        ElseIf Left$(S, 6) = "Drive " Then
            Drive1.Drive = Mid$(S, 7)
        ElseIf Left$(S, 4) = "Dir " Then
            Dir1.Path = Mid$(S, 5)
            File1.Path = Mid$(S, 5)
        End If
    Wend

    Close #1
End Sub

Sub SetFormCaption ()
    Dim S As String


    S = "Setup Apprentice - "

    If Len(AppName.Text) Then
        S = S & AppName.Text
    Else
        S = S & "New Application"
    End If

    If Len(SetupFilename) Then
        S = S & " [" & SetupFilename & "]"
    Else
        S = S & " [UNKNOWN.SA]"
    End If

    Form1.Caption = S
End Sub

Sub SetupClear ()
    fChanged = False
    AppName.Text = ""
    SetupFilename = ""
    IList(0).Clear
    IList(1).Clear
    IList(2).Clear
End Sub

Sub Timer1_Timer ()
    Dim I As Integer
    Dim N As Integer

    If StartDrag Then
        Timer1.Enabled = False
        N = 0

        Select Case DragStart
            Case -1:
                For I = 0 To File1.ListCount - 1
                    If File1.Selected(I) Then N = N + 1
                Next I

            Case Else:
                For I = 0 To IList(DragStart).ListCount - 1
                    If IList(DragStart).Selected(I) Then N = N + 1
                Next I
        End Select

        If N Then
            Select Case DragStart
                Case -1:
                    File1.DragIcon = Drop.Picture
                    File1.Drag 1

                Case Else:
                    IList(DragStart).DragIcon = Drop.Picture
                    IList(DragStart).Drag 1
            End Select
        End If

        StartDrag = False
    End If
End Sub